Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/jpi/graphics.bas

BASIC Source File | 1998-01-29 | 45.7 KB | 1,267 lines

Attribute VB_Name = "GraphicsEngine"
Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Global ResolutionX As Integer
Global ResolutionY As Integer
Global ResolutionMidX As Integer
Global ResolutionMidY As Integer
Global ColorDepth As Integer

' Transparent Blit
Option Compare Text

Global WindowRect As RECT
' Win32
Const IMAGE_BITMAP = 0
Const LR_LOADFROMFILE = &H10
Const LR_CREATEDIBSECTION = &H2000
Const SRCCOPY = &HCC0020

Global BattleSurfaceRect As RECT

Global Const FONT_SPACINGX = 8
Global Const FONT_SPACINGY = 12
Global Const FONT_SIZE = 12
Global FONT_LastCharacter As Integer
Global FONT_LastLine As Integer
Private FxClear As DDBLTFX
Private Type GfxEng
  TotalRefresh As Boolean
  DeviceOpen As Boolean
  TerrainRefreshSize As Integer
End Type
Public GraphicsEngineData As GfxEng
Private Type BITMAP
  bmType  As Long
  bmWidth  As Long
  bmHeight  As Long
  bmWidthBytes  As Long
  bmPlanes  As Integer
  bmBitsPixel  As Integer
  bmBits  As Long
End Type
' GDI32

Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
' USER32
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
'&HCC0020 is the dwRop (raster operation) thingy for using stretchblt to copy a pic
Dim dd As DirectDraw2
'Terrain
Private TerrainSurface As DirectDrawSurface3
'Battleview
Private BattleSurface As DirectDrawSurface3
'Control panel
Private ControlPanelSurface As DirectDrawSurface3

Private ddsdFront As DDSURFACEDESC      ' Front surface description
Private ddsFront As DirectDrawSurface3  ' Front buffer
Private ddsBack As DirectDrawSurface3
Private fx As DDBLTFX

Private ddCaps As DDSCAPS               ' Capabilities for search
Private lhdc As Long                    ' hDC for back buffer
Private PFormat1 As DDPIXELFORMAT
Global Const LINEMODE_NORMAL = 1
Global Const LINEMODE_SHADE = 2
Global Const BltType_Mask = 1
Global Const BltType_Fast = 2
Global GraphicSurfaces(100) As DirectDrawSurface3
Sub prepSrcColorKey(srf As DirectDrawSurface3)
Dim aColorkey As DDCOLORKEY
aColorkey.dwColorSpaceHighValue = 0
aColorkey.dwColorSpaceLowValue = 0
srf.SetColorKey DDCKEY_SRCBLT, aColorkey
End Sub
Public Sub SplashGraphic(PicIndex)
Dim SrcBox As RECT
SrcBox.Left = Pics(PicIndex).SourceRect.Left
SrcBox.Top = Pics(PicIndex).SourceRect.Top
SrcBox.bottom = Pics(PicIndex).Height + Pics(PicIndex).SourceRect.Top
SrcBox.Right = Pics(PicIndex).Width + Pics(PicIndex).SourceRect.Left
ddsBack.BltFast ResolutionMidX - Pics(PicIndex).HalfWidth, ResolutionMidY - Pics(PicIndex).HalfHeight, GraphicSurfaces(Pics(PicIndex).GraphicsLib), SrcBox, 0

End Sub
Public Sub RefreshRender()
TerrainSurface.Restore
Call ControlPanelSurface.Restore
Call RedrawControlPanel
Call RenderTerrain
End Sub
Public Sub GethDC()
ddsBack.GetDC lhdc
End Sub
Public Sub ReleasehDC()
ddsBack.ReleaseDC lhdc

End Sub
Public Sub DrawCursor()
'Cursor
'Call GraphicsEngine.PutGraphicOntoBackBuffer(Mouse.Position.X, Mouse.Position.Y, GameInterface.Mouse.CursorPic, BltType_Mask)
End Sub
Public Sub PutGraphicOntoBackBuffer(X, Y, PicIndex, BltType)
Dim DestBox As RECT, SrcBox As RECT
DestBox.Top = Y - Pics(PicIndex).HalfHeight
DestBox.Left = X - Pics(PicIndex).HalfWidth
DestBox.bottom = Y + Pics(PicIndex).HalfHeight
DestBox.Right = X + Pics(PicIndex).HalfWidth
SrcBox.Top = Pics(PicIndex).SourceRect.Top
SrcBox.Left = Pics(PicIndex).SourceRect.Left
SrcBox.bottom = Pics(PicIndex).SourceRect.Top + Pics(PicIndex).Height
SrcBox.Right = Pics(PicIndex).SourceRect.Left + Pics(PicIndex).Width
If DestBox.bottom > 0 Then
  If DestBox.Top < ResolutionY Then
    If DestBox.Right > 0 Then
      If DestBox.Left < ResolutionX Then
        If DestBox.Top < 0 Then
          SrcBox.Top = SrcBox.Top - DestBox.Top
          DestBox.Top = 0
        End If
        If DestBox.bottom > ResolutionY Then
          SrcBox.bottom = SrcBox.bottom - (DestBox.bottom - ResolutionY)
          DestBox.bottom = ResolutionY
        End If
        If DestBox.Left < 0 Then
          SrcBox.Left = SrcBox.Left - DestBox.Left
          DestBox.Left = 0
        End If
        If DestBox.Right > ResolutionX Then
          SrcBox.Right = SrcBox.Right - (DestBox.Right - ResolutionX)
          DestBox.Right = ResolutionX
        End If
        ' Set the transparent color
        GraphicSurfaces(Pics(PicIndex).GraphicsLib).Restore
        ' Blit the image to the back buffer
        Select Case BltType
        Case BltType_Mask
          ddsBack.BltFast DestBox.Left, DestBox.Top, GraphicSurfaces(Pics(PicIndex).GraphicsLib), SrcBox, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
        Case BltType_Fast
          ddsBack.BltFast DestBox.Left, DestBox.Top, GraphicSurfaces(Pics(PicIndex).GraphicsLib), SrcBox, 0
        End Select
      End If
    End If
  End If
End If

End Sub
Public Sub SwapScreen()
ddsFront.Flip Nothing, 0
End Sub
Public Sub PutGraphicOntoTerrain(X, Y, PicIndex, Direction, BltType As Integer)
Dim DestBox As RECT, SrcBox As RECT
With Pics(PicIndex)
    DestBox.Top = Y - .HalfHeight
    DestBox.Left = X - .HalfWidth
    DestBox.bottom = Y + .HalfHeight
    DestBox.Right = X + .HalfWidth
    SrcBox.Top = .SourceRect.Top
    SrcBox.Left = .SourceRect.Left + (.Width * Direction)
    SrcBox.bottom = .SourceRect.Top + .Height
    SrcBox.Right = .SourceRect.Left + .Width + (.Width * Direction)
    If DestBox.bottom > 0 Then
      If DestBox.Top < BattleViewPort.Height Then
        If DestBox.Right > 0 Then
          If DestBox.Left < BattleViewPort.Width Then
            If DestBox.Top < 0 Then
              SrcBox.Top = SrcBox.Top - DestBox.Top
              DestBox.Top = 0
            End If
            If DestBox.bottom > BattleViewPort.Height Then
              SrcBox.bottom = SrcBox.bottom - (DestBox.bottom - BattleViewPort.Height)
              DestBox.bottom = BattleViewPort.Height
            End If
            If DestBox.Left < 0 Then
              SrcBox.Left = SrcBox.Left - DestBox.Left
              DestBox.Left = 0
            End If
            If DestBox.Right > BattleViewPort.Width Then
              SrcBox.Right = SrcBox.Right - (DestBox.Right - BattleViewPort.Width)
              DestBox.Right = BattleViewPort.Width
            End If
            ' Set the transparent color


            GraphicSurfaces(.GraphicsLib).Restore
            ' Blit the image to the back buffer
            Select Case BltType
            Case BltType_Mask
              TerrainSurface.BltFast DestBox.Left, DestBox.Top, GraphicSurfaces(.GraphicsLib), SrcBox, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
            Case BltType_Fast
              TerrainSurface.BltFast DestBox.Left, DestBox.Top, GraphicSurfaces(.GraphicsLib), SrcBox, 0
            End Select
          End If
        End If
      End If
    End If
End With
End Sub
Public Sub PutGraphicOntoBattleView(X, Y, PicIndex, Direction, SpriteXOffset, SpriteYOffset)
Dim DestBox As RECT, SrcBox As RECT
On Error Resume Next
With Pics(PicIndex)
    DestBox.Top = Y - SpriteYOffset
    DestBox.Left = X - SpriteXOffset
    DestBox.bottom = (Y - SpriteYOffset) + .Height
    DestBox.Right = (X - SpriteXOffset) + .Width
    SrcBox.Top = .SourceRect.Top
    SrcBox.Left = .SourceRect.Left + (.Width * Direction)
    SrcBox.bottom = .SourceRect.Top + .Height
    SrcBox.Right = .SourceRect.Left + (.Width * (Direction + 1))
End With
With DestBox
  If .bottom > 0 Then
    If .Top < BattleSurfaceRect.bottom Then
      If .Right > 0 Then
        If .Left < BattleSurfaceRect.Right Then
          If .Top < 0 Then
            SrcBox.Top = SrcBox.Top - .Top
            .Top = 0
          End If
          If .bottom > BattleSurfaceRect.bottom Then
            SrcBox.bottom = SrcBox.bottom - (.bottom - BattleSurfaceRect.bottom)
          End If
          If .Left < 0 Then
            SrcBox.Left = SrcBox.Left - .Left
            .Left = 0
          End If
          If .Right > BattleSurfaceRect.Right Then
            SrcBox.Right = SrcBox.Right - (.Right - BattleSurfaceRect.Right)
          End If
          GraphicSurfaces(Pics(PicIndex).GraphicsLib).Restore
          BattleSurface.BltFast .Left, .Top, GraphicSurfaces(Pics(PicIndex).GraphicsLib), SrcBox, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
        End If
      End If
    End If
  End If
End With
End Sub
Public Function ClipPic(X, Y, PicIndex, OffsetX, OffsetY) As Boolean
ClipPic = False
If X - OffsetX > BattleViewPort.Width Then
  ClipPic = True
End If
If Y - OffsetY > BattleViewPort.Height Then
  ClipPic = True
End If
If (X + Pics(PicIndex).Width) - OffsetX < 0 Then
  ClipPic = True
End If
If (Y + Pics(PicIndex).Height) - OffsetY < 0 Then
  ClipPic = True
End If
End Function
Public Function Clip(X, Y) As Boolean
If X < 0 Then
  Clip = True
End If
If Y < 0 Then
  Clip = True
End If
If X > BattleViewPort.Width Then
  Clip = True
End If
If Y > BattleViewPort.Height Then
  Clip = True
End If
End Function
Public Function GetRGBVal(ColorValue, Pallete)
Select Case Pallete
Case PALLETE_RED
  GetRGBVal = RGB(ColorValue, 0, 0)
Case PALLETE_GREEN
  GetRGBVal = RGB(0, ColorValue, 0)
Case PALLETE_BLUE
  GetRGBVal = RGB(0, 0, ColorValue)
Case PALLETE_WHITE
  GetRGBVal = RGB(ColorValue, ColorValue, ColorValue)
Case PALLETE_YELLOW
  GetRGBVal = RGB(ColorValue, ColorValue, 0)
Case PALLETE_SKYBLUE
  GetRGBVal = RGB(0, ColorValue / 2, ColorValue)
End Select
End Function
Sub RenderTerrain()
For X = Map.ProjectToMapX(View.Left) To Map.ProjectToMapX(View.Left + View.Width)
  For Y = Map.ProjectToMapY(View.Top) To Map.ProjectToMapY(View.Top + View.Height)
    Call RenderTerrainBlock(X, Y)
  Next Y
Next X
End Sub
Sub UpdateScenery()
Static Count
Count = Count + 1
If Count = 6 Then
  Count = 0
  For X = Map.ProjectToMapX(View.Left) To Map.ProjectToMapX(View.Left + View.Width)
    For Y = Map.ProjectToMapY(View.Top) To Map.ProjectToMapY(View.Top + View.Height)
      If GroundBlocks(X, Y).TerrainType = TERRAINTYPE_WATER Then
        Call RenderTerrainBlock(X, Y)
        For I = 1 To GroundBlocks(X, Y).TerrainOverlayAmount
          GroundBlocks(X, Y).AnimFrames(I) = GroundBlocks(X, Y).AnimFrames(I) + 1
          If GroundBlocks(X, Y).AnimFrames(I) > Sprites(GroundBlocks(X, Y).SpriteNumbers(I)).SpriteGroups(GroundBlocks(X, Y).DamageAmount + 1).FrameMax Then
            GroundBlocks(X, Y).AnimFrames(I) = 1
          End If
        Next I
      End If
    Next Y
  Next X
End If
End Sub
Sub MoveTerrain(Direction, Distance)
Dim temprect As RECT
Select Case Direction
Case DIRECTION_UP
  With temprect
    .bottom = BattleViewPort.Height - Distance
    .Right = BattleViewPort.Width
  End With
  TerrainSurface.BltFast 0, Distance, TerrainSurface, temprect, 0
  For X = Map.ProjectToMapX(View.Left) To Map.ProjectToMapX(View.Left + View.Width)
    For Y = Map.ProjectToMapY(View.Top) To Map.ProjectToMapY(View.Top) + GraphicsEngineData.TerrainRefreshSize
      Call RenderTerrainBlock(X, Y)
    Next Y
  Next X
Case DIRECTION_RIGHT
  With temprect
    .bottom = BattleViewPort.Height
    .Right = BattleViewPort.Width
    .Left = Distance
  End With
  TerrainSurface.BltFast 0, 0, TerrainSurface, temprect, 0
  For Y = Map.ProjectToMapY(View.Top) To Map.ProjectToMapY(View.Top + View.Height)
    For X = Map.ProjectToMapX(View.Left + View.Width) - GraphicsEngineData.TerrainRefreshSize To Map.ProjectToMapX(View.Left + View.Width) + 1
      Call RenderTerrainBlock(X, Y)
    Next X
  Next Y
Case DIRECTION_DOWN
  With temprect
    .Top = Distance
    .bottom = BattleViewPort.Height
    .Right = BattleViewPort.Width
  End With
  TerrainSurface.BltFast 0, 0, TerrainSurface, temprect, 0
  For X = Map.ProjectToMapX(View.Left) To Map.ProjectToMapX(View.Left + View.Width)
    For Y = Map.ProjectToMapY(View.Top + View.Height) - GraphicsEngineData.TerrainRefreshSize To Map.ProjectToMapY(View.Top + View.Height)
      Call RenderTerrainBlock(X, Y)
    Next Y
  Next X
Case DIRECTION_LEFT
  With temprect
    .bottom = BattleViewPort.Height
    .Right = BattleViewPort.Width - Distance
  End With
  TerrainSurface.BltFast Distance, 0, TerrainSurface, temprect, 0
  For Y = Map.ProjectToMapY(View.Top) To Map.ProjectToMapY(View.Top + View.Height)
    For X = Map.ProjectToMapX(View.Left) To Map.ProjectToMapX(View.Left) + GraphicsEngineData.TerrainRefreshSize
      Call RenderTerrainBlock(X, Y)
    Next X
  Next Y
End Select
End Sub
Sub TilePic(PicIndex)
Dim temprect As RECT
With Pics(PicIndex)
  TileMaxX = Int(ResolutionX / .Width)
  TileMaxY = Int(ResolutionY / .Height)
  temprect.bottom = .Height
  temprect.Right = .Width
  For X = 0 To TileMaxX - 1
    For Y = 0 To TileMaxY - 1

      ddsBack.BltFast X * .Width, Y * .Height, GraphicSurfaces(Pics(PicIndex).GraphicsLib), temprect, DDBLTFAST_WAIT



    Next Y
  Next X
End With
End Sub
Sub DisplayControlPanel()
Dim temprect As RECT
With temprect
  .Right = GameControlPanel.Width
  .bottom = GameControlPanel.Height
End With
ddsBack.BltFast GameControlPanel.PortRect.Left, GameControlPanel.PortRect.Top, ControlPanelSurface, temprect, DDBLTFAST_WAIT
End Sub
Sub RenderMoneyValue()
Call DisplayText("CREDITS: " & Format$(Player(LocalPlayer.PlayerIndex).Money, "0000"), 1, 1, PALLETE_WHITE)
End Sub
Sub RenderRadar()
If RadarWindow.Enabled = True Then
  ddsBack.BltFast RadarWindow.PortRect.Left, RadarWindow.PortRect.Top, GraphicSurfaces(Pics(InGameConstants(InGameConstant_PICINDEX_RadarBackground)).GraphicsLib), Pics(InGameConstants(InGameConstant_PICINDEX_RadarBackground)).SourceRect, DDBLTFAST_WAIT
End If
End Sub
Sub RedrawControlPanel()
For I = 1 To Int(ResolutionX / Pics(InGameConstants(InGameConstant_PICINDEX_ControlPanelBackground)).Width)
  ControlPanelSurface.BltFast XPos, 0, GraphicSurfaces(Pics(InGameConstants(InGameConstant_PICINDEX_ControlPanelBackground)).GraphicsLib), Pics(InGameConstants(InGameConstant_PICINDEX_ControlPanelBackground)).SourceRect, DDBLTFAST_WAIT
  XPos = XPos + Pics(InGameConstants(InGameConstant_PICINDEX_ControlPanelBackground)).Width
Next I
ControlPanelSurface.BltFast RadarButton.PortRect.Left, RadarButton.PortRect.Top - GameControlPanel.PortRect.Top, GraphicSurfaces(Pics(InGameConstants(InGameConstant_PICINDEX_RadarButtonPic)).GraphicsLib), Pics(InGameConstants(InGameConstant_PICINDEX_RadarButtonPic)).SourceRect, DDBLTFAST_WAIT
Call RedrawBuildWindows
End Sub
Sub RedrawBuildWindows()
If Player(LocalPlayer.PlayerIndex).BuildClassesActive > 0 Then
  For I = 1 To MAXBUILDWINDOWS
    If Player(LocalPlayer.PlayerIndex).BuildClasses(Player(LocalPlayer.PlayerIndex).CurrentlySelectedBuildClass + (I - 1)).Active = True Then
      CurrentDisplayBuildClass = Player(LocalPlayer.PlayerIndex).BuildClasses(Player(LocalPlayer.PlayerIndex).CurrentlySelectedBuildClass + (I - 1)).ClassReference
      ControlPanelSurface.BltFast BuildWindows(I).PortRect.Left - GameControlPanel.PortRect.Left, BuildWindows(I).PortRect.Top - GameControlPanel.PortRect.Top, GraphicSurfaces(Pics(ObjModels(CurrentDisplayBuildClass).Attributes(ATTRIBUTE_BUILDPICTURE)).GraphicsLib), Pics(ObjModels(CurrentDisplayBuildClass).Attributes(ATTRIBUTE_BUILDPICTURE)).SourceRect, DDBLTFAST_WAIT
      For I2 = 1 To Player(LocalPlayer.PlayerIndex).BuildsInProgressesActive
        If Player(LocalPlayer.PlayerIndex).BuildClasses(Player(LocalPlayer.PlayerIndex).CurrentlySelectedBuildClass + (I - 1)).ClassReference = Player(LocalPlayer.PlayerIndex).BuildsInProgress(I2).ClassReference Then
          If Player(LocalPlayer.PlayerIndex).BuildsInProgress(I2).CanBePlaced = True Then
            ControlPanelSurface.BltFast BuildWindows(I).PortRect.Left - GameControlPanel.PortRect.Left, BuildWindows(I).PortRect.Top - GameControlPanel.PortRect.Top, GraphicSurfaces(Pics(InGameConstants(InGameConstant_PICINDEX_BuildReadyPic)).GraphicsLib), Pics(InGameConstants(InGameConstant_PICINDEX_BuildReadyPic)).SourceRect, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
            Player(LocalPlayer.PlayerIndex).BuildClasses(Player(LocalPlayer.PlayerIndex).CurrentlySelectedBuildClass + (I - 1)).Enabled = True
            Exit For
          End If

        End If
      Next I2
      If Player(LocalPlayer.PlayerIndex).BuildClasses(Player(LocalPlayer.PlayerIndex).CurrentlySelectedBuildClass + (I - 1)).Enabled = False Then
        ControlPanelSurface.BltFast BuildWindows(I).PortRect.Left - GameControlPanel.PortRect.Left, BuildWindows(I).PortRect.Top - GameControlPanel.PortRect.Top, GraphicSurfaces(Pics(InGameConstants(InGameConstant_PICINDEX_BuildDisabledPic)).GraphicsLib), Pics(InGameConstants(InGameConstant_PICINDEX_BuildDisabledPic)).SourceRect, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY
      End If
    End If
  Next I
End If
End Sub
Sub Render()
'Beta information
If GraphicsEngineData.TotalRefresh = True Then
  GraphicsEngineData.TotalRefresh = False
  Call RedrawControlPanel
  Call RenderTerrain
End If
Call DisplayControlPanel
Call RenderBattleView
Call RenderMoneyValue
For I = 1 To Internet.MaxMessages
  If Internet.InternetMessageBox.LinesActive(I) = True Then
    Call DisplayText(Internet.InternetMessageBox.TextLines(I), 12, 17 + ((I - 1) * FONT_SPACINGY), PALLETE_WHITE)
    MaxMessage = I
  End If
Next I
If InterfaceFlags.WritingAMessage = True Then
  Call DisplayText("say: " & InterfaceFlags.Message, 12, 17 + (MaxMessage * FONT_SPACINGY), 0)
End If
Call RenderRadar
If MessageWindow.Active = True Then Call DisplayMessageWindow
Call DrawCursor
Call SwapScreen
End Sub
Private Sub RenderTerrainBlock(GroundX, GroundY)
Dim BltType As Integer
If GroundX < 0 Then Exit Sub
If GroundY < 0 Then Exit Sub
DisplayX = GameInterface.ProjectXToView(Map.UnProjectToMapX(GroundX))
DisplayY = GameInterface.ProjectYToView(Map.UnProjectToMapY(GroundY)) '- GroundBlocks(GroundX, GroundY).Height
Call PutGraphicOntoTerrain(DisplayX, DisplayY, Sprites(GroundBlocks(GroundX, GroundY).SpriteNumbers(1)).SpriteGroups(GroundBlocks(GroundX, GroundY).DamageAmount + 1).Frames(GroundBlocks(GroundX, GroundY).AnimFrames(1)).PicNum, 0, BltType_Fast)
For I = 2 To GroundBlocks(GroundX, GroundY).TerrainOverlayAmount
  Call PutGraphicOntoTerrain(DisplayX, DisplayY, Sprites(GroundBlocks(GroundX, GroundY).SpriteNumbers(I)).SpriteGroups(GroundBlocks(GroundX, GroundY).DamageAmount + 1).Frames(GroundBlocks(GroundX, GroundY).AnimFrames(I)).PicNum, 0, BltType_Mask)
Next I
End Sub
Private Sub AnimTerrainBlock(GroundX, GroundY)
For I = 1 To GroundBlocks(GroundX, GroundY).TerrainOverlayAmount
  GroundBlocks(GroundX, GroundY).AnimFrames(I) = GroundBlocks(GroundX, GroundY).AnimFrames(I) + 1
  If GroundBlocks(GroundX, GroundY).AnimFrames(I) > Sprites(GroundBlocks(GroundX, GroundY).SpriteNumbers(I)).SpriteGroups(GroundBlocks(GroundX, GroundY).DamageAmount + 1).FrameMax Then
    GroundBlocks(GroundX, GroundY).AnimFrames(I) = 1
  End If
Next I
End Sub
Private Sub DrawStraightLine(X, Y, Distance, R, G, B, Direction)
X1 = X
Y1 = Y
RGBVAL = RGB(R, G, B)
SetPixelV lhdc, X1, Y1, RGBVAL
For I = 1 To Distance
  Select Case Direction
  Case DIRECTION_UP
    Y1 = Y1 - 1
  Case DIRECTION_DOWN
    Y1 = Y1 + 1
  Case DIRECTION_LEFT
    X1 = X1 - 1
  Case DIRECTION_RIGHT
    X1 = X1 + 1
  End Select
  SetPixelV lhdc, X1, Y1, RGBVAL
Next I
End Sub
Private Sub RenderSelectedBoxes()
BattleSurface.GetDC lhdc
'Selected object's outline
For I = 1 To GameInterface.ObjectSelectedList.IndexesActive
  With Objects(ObjectSelectedList.Indexes(I))
    spritewidth = Pics(Sprites(.Sprite.SpriteNumber).SpriteGroups(.Sprite.SpriteGroupNumber).Frames(.Sprite.SpriteFrameNumber).PicNum).Width
    spriteheight = Pics(Sprites(.Sprite.SpriteNumber).SpriteGroups(.Sprite.SpriteGroupNumber).Frames(.Sprite.SpriteFrameNumber).PicNum).Height
    OffX = ObjModels(.ModelIndex).Attributes(ATTRIBUTE_SPRITEPOSITIONX)
    OffY = ObjModels(.ModelIndex).Attributes(ATTRIBUTE_SPRITEPOSITIONY)
    CenterX = ProjectXToView(.Position.X)
    CenterY = ProjectYToView(.Position.Y)
    Call DrawStraightLine(CenterX - OffX, CenterY - OffY, 4, 150, 150, 150, DIRECTION_RIGHT)
    Call DrawStraightLine(CenterX - OffX, CenterY - OffY, 4, 150, 150, 150, DIRECTION_DOWN)

    Call DrawStraightLine((CenterX - OffX) + spritewidth, (CenterY - OffY) + spriteheight, 4, 150, 150, 150, DIRECTION_UP)
    Call DrawStraightLine((CenterX - OffX) + spritewidth, (CenterY - OffY) + spriteheight, 4, 150, 150, 150, DIRECTION_LEFT)

    Call DrawStraightLine(CenterX - OffX, (CenterY - OffY) + spriteheight, 4, 150, 150, 150, DIRECTION_UP)
    Call DrawStraightLine(CenterX - OffX, (CenterY - OffY) + spriteheight, 4, 150, 150, 150, DIRECTION_RIGHT)

    Call DrawStraightLine((CenterX - OffX) + spritewidth, CenterY - OffY, 4, 150, 150, 150, DIRECTION_DOWN)
    Call DrawStraightLine((CenterX - OffX) + spritewidth, CenterY - OffY, 4, 150, 150, 150, DIRECTION_LEFT)


    Call DrawBox((CenterX - OffX) + 5, CenterY - OffY - 1, ((CenterX - OffX) + spritewidth) - 5, CenterY - OffY + 1, 0, 100, 0, 0, 0, 0, LINEMODE_NORMAL)
    HealthBright = .Properties(PROPERTY_HEALTH) / (ObjModels(.ModelIndex).Attributes(ATTRIBUTE_HEALTH) / 255)
    Call DrawLine((CenterX - OffX) + 6, CenterY - OffY, ((CenterX - OffX) + spritewidth) - 6, CenterY - OffY, 0, 0, HealthBright, 0, 0, 0, LINEMODE_NORMAL)
  End With
Next I
BattleSurface.ReleaseDC lhdc
End Sub
Sub RenderInterface()

If InterfaceFlags.PlacingABuilding = True Then
    Dim TempPos As Point3D
    'For rendering the build option
    ModelNum = InterfaceFlags.PlaceIndex
    TempPos = Map.RoundToMap3DPoint(Mouse.Position)
    Call PutGraphicOntoBattleView(TempPos.X, TempPos.Y, SpriteStuff.Sprites(ObjModels(ModelNum).Attributes(ATTRIBUTE_SPRITE)).SpriteGroups(1).Frames(1).PicNum, 0, ObjModels(ModelNum).Attributes(ATTRIBUTE_SPRITEPOSITIONX), ObjModels(ModelNum).Attributes(ATTRIBUTE_SPRITEPOSITIONY))
End If

BattleSurface.GetDC lhdc
'Mouse-Box for selecting objects
If Mouse.IsDragging = True Then
  If Math.GetDistance(Mouse.DragCurrentPosition, Mouse.DragStartPosition) > 8 Then
    With Mouse.DragCurrentPosition
      FromX = .X - BattleViewPort.PortRect.Left
      FromY = .Y - BattleViewPort.PortRect.Top
      ToX = Mouse.DragStartPosition.X - BattleViewPort.PortRect.Left
      ToY = Mouse.DragStartPosition.Y - BattleViewPort.PortRect.Top
    End With
    With BattleViewPort
      If ToX > .Width - 1 Then ToX = .Width - 1
      If ToY > .Height - 1 Then ToY = .Height - 1
    End With
    If ToX - 4 < FromX Then
      If ToX + 4 > FromX Then
        If ToY - 4 < FromY Then
          If ToY + 4 > FromY Then
            DontDrawLine = True
          End If
        End If
      End If
    End If
    If DontDrawLine = False Then Call DrawBox(FromX, FromY, ToX, ToY, 255, 0, 0, 0, 0, 255, LINEMODE_SHADE)
  End If
End If
BattleSurface.ReleaseDC lhdc
End Sub
Sub RenderBattleView()
If GameEngine.View.ScrollSpeedEW = 0 Then
  If GameEngine.View.ScrollSpeedNS = 0 Then

    Call UpdateScenery
  End If
End If
BattleSurface.BltFast 0, 0, TerrainSurface, BattleSurfaceRect, 0
Call RenderObjects
Call RenderVisualEffects
Call RenderSelectedBoxes
Call RenderInterface
'puts the completed scene onto the backbuffer
ddsBack.BltFast BattleViewPort.PortRect.Left, BattleViewPort.PortRect.Top, BattleSurface, BattleSurfaceRect, DDBLTFAST_WAIT
End Sub
Sub RenderVisualEffects()
BattleSurface.GetDC lhdc

Call RenderSparkles
Call RenderSparks

BattleSurface.ReleaseDC lhdc

Call RenderAnimations
End Sub
Sub RenderObjects()
Dim EliminatedObjects(MAXOBJECTS) As Boolean, EntitiesToRender(MAXOBJECTS), RenderX(MAXOBJECTS), RenderY(MAXOBJECTS), Clips(MAXOBJECTS) As Boolean
BestRenderY = ResolutionY + 100
ClosestRenderY = -9999
For I = 1 To ObjectsActive
  RenderX(I) = ProjectXToView(Objects(I).Position.X)
  RenderY(I) = ProjectYToView(Objects(I).Position.Y) - (Objects(I).Position.Z / 3)
  If ObjModels(Objects(I).ModelIndex).ObjClassName = "TestBase" Then
     dsfsdf = 4
  End If
Next I
For I = 1 To ObjectsActive
  With Objects(I)
    If .Frozen = False Then
      If CheckObject(I, OBJCHECK_VISIBLE) = True Then
        Clips(I) = ClipPic(RenderX(I), RenderY(I), SpriteStuff.Sprites(.Sprite.SpriteNumber).SpriteGroups(.Sprite.SpriteGroupNumber).Frames(.Sprite.SpriteFrameNumber).PicNum, ObjModels(.ModelIndex).Attributes(ATTRIBUTE_SPRITEPOSITIONX), ObjModels(.ModelIndex).Attributes(ATTRIBUTE_SPRITEPOSITIONY))
      Else
        Clips(I) = True
      End If
    Else
      Clips(I) = True
    End If
  End With
Next I
For I2 = 1 To ObjectsActive
    If Clips(I2) = False Then
        ClosestRenderY = -9999
        ClosestRenderObj = NOOBJECT
        For I = 1 To ObjectsActive
          If EliminatedObjects(I) = False Then
            If CheckObject(I, OBJCHECK_ALIVE) = True Then
              If Clips(I) = False Then
                If RenderY(I) <= BestRenderY Then
                  If RenderY(I) >= ClosestRenderY Then
                    ClosestRenderY = RenderY(I)
                    ClosestRenderObj = I
                  End If
                End If
              End If
            End If
          End If
        Next I
        If ClosestRenderObj <> NOOBJECT Then
          EliminatedObjects(ClosestRenderObj) = True
          NextToRender = NextToRender + 1
          EntitiesToRender(NextToRender) = ClosestRenderObj
        End If
    End If
Next I2
If NextToRender > 0 Then
  For I = NextToRender To 1 Step -1
    With Objects(EntitiesToRender(I))
      If ObjModels(.ModelIndex).Abilities(ABILITY_HASSHADOW) = True Then
        If .Position.Z > GroundBlocks(.MapPosition.X, .MapPosition.Y).Height Then
          Call PutGraphicOntoBattleView(RenderX(EntitiesToRender(I)), ProjectYToView(Objects(EntitiesToRender(I)).Position.Y) - (GroundBlocks(.MapPosition.X, .MapPosition.Y).Height / 3), ObjModels(.ModelIndex).Attributes(ATTRIBUTE_SHADOWPIC), 0, ObjModels(.ModelIndex).Attributes(ATTRIBUTE_TOPSPRITEPOSITIONX), ObjModels(.ModelIndex).Attributes(ATTRIBUTE_TOPSPRITEPOSITIONY))
        End If
      End If
      Call PutGraphicOntoBattleView(RenderX(EntitiesToRender(I)), RenderY(EntitiesToRender(I)), SpriteStuff.Sprites(.Sprite.SpriteNumber).SpriteGroups(.Sprite.SpriteGroupNumber).Frames(.Sprite.SpriteFrameNumber).PicNum, .DisplayDirection, ObjModels(.ModelIndex).Attributes(ATTRIBUTE_SPRITEPOSITIONX), ObjModels(.ModelIndex).Attributes(ATTRIBUTE_SPRITEPOSITIONY))
      If ObjModels(.ModelIndex).Abilities(ABILITY_BODYISBISECTED) = True Then
        Call PutGraphicOntoBattleView(RenderX(EntitiesToRender(I)), RenderY(EntitiesToRender(I)), SpriteStuff.Sprites(.TopSprite.SpriteNumber).SpriteGroups(.TopSprite.SpriteGroupNumber).Frames(.TopSprite.SpriteFrameNumber).PicNum, .TopDisplayDirection, ObjModels(.ModelIndex).Attributes(ATTRIBUTE_TOPSPRITEPOSITIONX), ObjModels(.ModelIndex).Attributes(ATTRIBUTE_TOPSPRITEPOSITIONY))
      End If
    End With
  Next I
End If
End Sub

Sub RenderAnimations()
'Animations!
For I = 1 To VisualEffects.AnimsActive
  With Animations(I)
    If .Active = True Then
      RenderX = ProjectXToView(.Position.X)
      RenderY = ProjectYToView(.Position.Y)
      If Clip(RenderX, RenderY) = False Then
        PicNum = SpriteStuff.Sprites(.SpriteNum).SpriteGroups(1).Frames(.CurrentFrame).PicNum
        Call PutGraphicOntoBattleView(RenderX, RenderY, PicNum, .CurrentFrame, Pics(PicNum).HalfWidth, Pics(PicNum).HalfHeight)
      End If
    End If
  End With
Next I
End Sub
Sub RenderSparks()
For I = 1 To SparksActive
  With Sparks(I)
    If .Active = True Then
      RenderX = ProjectXToView(.Position.X)
      RenderY = ProjectYToView(.Position.Y) - (.Position.Z / 2)
      If Clip(RenderX, RenderY) = False Then
        HealthVal = .Health + 50
        If HealthVal > 255 Then HealthVal = 255
        ColVal = GetRGBVal(HealthVal, .Pallete)
        a = SetPixelV(lhdc, RenderX, RenderY, ColVal)
      End If
    End If
  End With
Next I
End Sub
Public Sub RenderSparkles()
For I = 1 To SparklesActive
  With Sparkles(I)
    If .Active = True Then
      For I2 = 1 To 3
        RenderX = ProjectXToView(.Position.X) + ((2 * Rnd) - 1)
        RenderY = (ProjectYToView(.Position.Y) - (.Position.Z / 2)) + ((2 * Rnd) - 1)
        If Clip(RenderX, RenderY) = False Then
          ColVal = GetRGBVal(.Health, .Pallete)
          a = SetPixelV(lhdc, RenderX, RenderY, ColVal)
        End If
      Next I2
    End If
  End With
Next I
End Sub
Sub DisplayMessageWindow()
Dim temprect As RECT
temprect.Top = 0
temprect.Left = 0
temprect.bottom = Pics(InGameConstants(InGameConstant_PICINDEX_MessageWindowPic)).Height
temprect.Right = Pics(InGameConstants(InGameConstant_PICINDEX_MessageWindowPic)).Width
ddsBack.BltFast ResolutionMidX - Pics(InGameConstants(InGameConstant_PICINDEX_MessageWindowPic)).HalfWidth, ResolutionMidY - Pics(InGameConstants(InGameConstant_PICINDEX_MessageWindowPic)).HalfHeight, GraphicSurfaces(Pics(InGameConstants(InGameConstant_PICINDEX_MessageWindowPic)).GraphicsLib), temprect, 0
PlaceX = ResolutionMidX - (((Len(MessageWindow.Caption) + 1) * FONT_SPACINGX) / 2)
PlaceY = (ResolutionMidY - Pics(InGameConstants(InGameConstant_PICINDEX_MessageWindowPic)).HalfHeight)
Call DisplayText(MessageWindow.Caption, PlaceX, PlaceY + 13, 0)

LineSize = 26
EndPoint = LineSize
If EndPoint > Len(MessageWindow.Text) Then EndPoint = Len(MessageWindow.Text)
StartPoint = 1
Do
  Call DisplayText(Mid$(MessageWindow.Text, StartPoint, (EndPoint - StartPoint) + 1), (ResolutionMidX - Pics(InGameConstants(InGameConstant_PICINDEX_MessageWindowPic)).HalfWidth) + 15, PlaceY + 38 + (LineCount * FONT_SPACINGY), 0)
  If EndPoint = Len(MessageWindow.Text) Then Exit Do
  StartPoint = StartPoint + LineSize
  If StartPoint > Len(MessageWindow.Text) Then Exit Do
  EndPoint = EndPoint + LineSize
  If EndPoint > Len(MessageWindow.Text) Then EndPoint = Len(MessageWindow.Text)
  LineCount = LineCount + 1
Loop
End Sub
Sub OpenGraphicsDevice()
' Set some constant values (from WIN32API.TXT).
Const conHwndTopmost = -1
Const conHwndNoTopmost = -2
Const conSwpNoActivate = &H10
Const conSwpShowWindow = &H40

Call ViewForm.OpenGameView
' Turn on the TopMost attribute.
SetWindowPos ViewForm.hwnd, conHwndTopmost, 0, 0, 0, 0, conSwpNoActivate Or conSwpShowWindow

DirectDrawCreate ByVal 0&, dd, Nothing
' This app is full screen and will change the display mode
dd.SetCooperativeLevel ViewForm.hwnd, DDSCL_EXCLUSIVE Or DDSCL_FULLSCREEN
' Set the display mode
dd.SetDisplayMode ResolutionX, ResolutionY, ColorDepth, 0, 0
With ddsdFront
  ' Structure size
  .dwSize = Len(ddsdFront)
  ' Use DDSD_CAPS and BackBufferCount
  .dwFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
  ' Primary, flipable surface

  If Program.ProgramData.UsesSystemMemoryForBackbuffer = True Then
    .DDSCAPS.dwCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX Or DDSCAPS_SYSTEMMEMORY
  Else
    .DDSCAPS.dwCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX
  End If
  ' One back buffer (you can try 2)
  .dwBackBufferCount = 1
End With
WindowRect.Top = 0
WindowRect.Left = 0
WindowRect.Right = ResolutionX
WindowRect.bottom = ResolutionY
BattleSurfaceRect.Top = 0
BattleSurfaceRect.Left = 0
BattleSurfaceRect.Right = BattleViewPort.Width
BattleSurfaceRect.bottom = BattleViewPort.Height

dd.CreateSurface ddsdFront, ddsFront, Nothing
ddCaps.dwCaps = DDSCAPS_BACKBUFFER
ddsFront.GetAttachedSurface ddCaps, ddsBack
fx.ddckSrcColorkey.dwColorSpaceHighValue = RGB(0, 0, 0)
fx.ddckSrcColorkey.dwColorSpaceLowValue = RGB(0, 0, 0)
fx.dwSize = Len(fx)
FxClear.dwSize = Len(fx)
FxClear.dwFillColor = RGB(0, 0, 0)
GraphicsEngineData.DeviceOpen = True
Set TerrainSurface = CreateSurface(BattleViewPort.Width, BattleViewPort.Height)
Set BattleSurface = CreateSurface(BattleViewPort.Width, BattleViewPort.Height)
Set ControlPanelSurface = CreateSurface(GameControlPanel.Width, GameControlPanel.Height)
'ShowCursor 0
End Sub
Public Sub ChangeGraphicsMode(ResX, ResY, BitDepth)
ResolutionX = ResX
ResolutionY = ResY
ResolutionMidX = ResX / 2
ResolutionMidY = ResY / 2
FONT_LastCharacter = ResolutionX / FONT_SPACINGX
FONT_LastLine = ResolutionY / FONT_SPACINGY
ColorDepth = BitDepth
End Sub
Sub ClearBackBuffer()
Call GraphicsEngine.TilePic(InGameConstants(InGameConstant_PICINDEX_ClearBackground))
End Sub
Sub TempOpenGraphicsDevice()
Call ViewForm.OpenGameView
DirectDrawCreate ByVal 0&, dd, Nothing
' This app is full screen and will change the display mode
dd.SetCooperativeLevel ViewForm.hwnd, DDSCL_EXCLUSIVE Or DDSCL_FULLSCREEN
' Set the display mode
dd.SetDisplayMode ResolutionX, ResolutionY, ColorDepth, 0, 0
With ddsdFront
  ' Structure size
  .dwSize = Len(ddsdFront)
  ' Use DDSD_CAPS and BackBufferCount
  .dwFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
  ' Primary, flipable surface

  If Program.ProgramData.UsesSystemMemoryForBackbuffer = True Then
    .DDSCAPS.dwCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX Or DDSCAPS_SYSTEMMEMORY
  Else
    .DDSCAPS.dwCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX
  End If
  ' One back buffer (you can try 2)
  .dwBackBufferCount = 1
End With
dd.CreateSurface ddsdFront, ddsFront, Nothing
ddCaps.dwCaps = DDSCAPS_BACKBUFFER
ddsFront.GetAttachedSurface ddCaps, ddsBack
fx.ddckSrcColorkey.dwColorSpaceHighValue = 0
fx.ddckSrcColorkey.dwColorSpaceLowValue = 0
fx.dwSize = Len(fx)
FxClear.dwSize = Len(fx)
FxClear.dwFillColor = RGB(0, 0, 0)
GraphicsEngineData.DeviceOpen = True
TerrainSurface.Restore
BattleSurface.Restore
ControlPanelSurface.Restore
'ShowCursor 0
End Sub
Sub TempCloseGraphicsDevice()
DoEvents
dd.FlipToGDISurface
dd.RestoreDisplayMode
dd.SetCooperativeLevel 0, DDSCL_NORMAL
GraphicsEngineData.DeviceOpen = False
End Sub
Sub CloseGraphicsDevice()
'ShowCursor 1
Call SpriteStuff.UnloadGraphicLibraries
Set TerrainSurface = Nothing
Set ControlPanelSurface = Nothing
Set BattleSurface = Nothing
DoEvents
dd.FlipToGDISurface
dd.RestoreDisplayMode
dd.SetCooperativeLevel 0, DDSCL_NORMAL
Set ddsBack = Nothing
Set ddsFront = Nothing
Set dd = Nothing
Call ViewForm.DestroyGameView
GraphicsEngineData.DeviceOpen = False
End Sub
Sub DrawBox(X1, Y1, X2, Y2, R1, G1, B1, R2, G2, B2, Mode)
If Mode = LINEMODE_NORMAL Then
  If X2 < X1 Then
    X3 = X1
    X1 = X2
    X2 = X1
  End If
  If Y2 < Y1 Then
    Y3 = Y1
    Y1 = Y2
    Y2 = Y1
  End If
  Color1 = RGB(R1, G1, B1)
  Y = Y1
  For X = X1 To X2
    SetPixelV lhdc, X, Y, Color1
  Next X
  Y = Y2
  For X = X1 To X2
    SetPixelV lhdc, X, Y, Color1
  Next X
  X = X1
  For Y = Y1 To Y2
    SetPixelV lhdc, X, Y, Color1
  Next Y
  X = X2
  For Y = Y1 To Y2
    SetPixelV lhdc, X, Y, Color1
  Next Y
Else
  Call DrawLine(X1, Y1, X2, Y1, R1, G1, B1, R2, G2, B2, Mode)
  Call DrawLine(X1, Y1, X1, Y2, R1, G1, B1, R2, G2, B2, Mode)
  Call DrawLine(X2, Y2, X2, Y1, R1, G1, B1, R2, G2, B2, Mode)
  Call DrawLine(X2, Y2, X1, Y2, R1, G1, B1, R2, G2, B2, Mode)
End If
End Sub
Sub DrawLine(X1, Y1, X2, Y2, R1, G1, B1, R2, G2, B2, Mode)
On Error Resume Next
XDiff = X1 - X2
YDiff = Y1 - Y2
If YDiff < 0 Then ChangeY = True: YDiff = -YDiff
If XDiff < 0 Then ChangeX = True: XDiff = -XDiff
If YDiff > XDiff Then
  LengthOfLine = YDiff
  XInc = XDiff / YDiff
  YInc = 1
Else
  LengthOfLine = XDiff
  YInc = YDiff / XDiff
  XInc = 1
End If
If ChangeY = True Then YInc = -YInc
If ChangeX = True Then XInc = -XInc
CurrX = X1
CurrY = Y1
Select Case Mode
Case LINEMODE_SHADE
  RDiff = R2 - R1
  RI = (RDiff / LengthOfLine)
  GDiff = G2 - G1
  GI = (GDiff / LengthOfLine)
  BDiff = B2 - B1
  BI = (BDiff / LengthOfLine)
End Select
SetPixelV lhdc, X1, Y1, RGB(R1, G1, B1)
For I = 1 To LengthOfLine
  CurrX = CurrX - XInc
  CurrY = CurrY - YInc
  Select Case Mode
  Case LINEMODE_NORMAL
    Color1 = RGB(R1, G1, B1)
  Case LINEMODE_SHADE
    Color1 = RGB(R1 + (RI * I), G1 + (GI * I), B1 + (BI * I))
  End Select
  SetPixelV lhdc, CurrX, CurrY, Color1
Next I
End Sub
Private Function CreateSurface(Width, Height) As DirectDrawSurface2
Dim ddsd As DDSURFACEDESC       ' Surface description
Dim dds As DirectDrawSurface2   ' Created surface
With ddsd
    .dwSize = Len(ddsd)
    .dwFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
    .DDSCAPS.dwCaps = DDSCAPS_OFFSCREENPLAIN
    .dwWidth = Width
    .dwHeight = Height
End With
dd.CreateSurface ddsd, dds, Nothing

' Restore the surface
dds.Restore
' Returns the new surface
Set CreateSurface = dds
End Function
Private Sub LoadGraphicOntoGraphicLib(Index, dd As DirectDraw2, ByVal strFile As String)
Dim hbm As Long                 ' Handle on bitmap
Dim bm As BITMAP                ' Bitmap header
Dim ddsd As DDSURFACEDESC       ' Surface description
Dim dds As DirectDrawSurface2   ' Created surface
Dim hdcImage As Long            ' Handle on image
Dim lhdc As Long                ' Handle on surface context
' Load bitmap
hbm = LoadImage(ByVal 0&, strFile, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)
' Get bitmap info
GetObject hbm, Len(bm), bm
' Fill surface description
With ddsd
    .dwSize = Len(ddsd)
    .dwFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
    .DDSCAPS.dwCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    .dwWidth = bm.bmWidth
    .dwHeight = bm.bmHeight
End With
GraphicsLibs(Index).Width = bm.bmWidth
GraphicsLibs(Index).HalfWidth = Int(bm.bmWidth / 2)
GraphicsLibs(Index).Height = bm.bmHeight
GraphicsLibs(Index).HalfHeight = Int(bm.bmHeight / 2)
' Create surface
dd.CreateSurface ddsd, dds, Nothing
' Create memory device
hdcImage = CreateCompatibleDC(ByVal 0&)
' Select the bitmap in this memory device
SelectObject hdcImage, hbm
' Restore the surface
dds.Restore
' Get the surface's DC
dds.GetDC lhdc
' Copy from the memory device to the DirectDrawSurface
StretchBlt lhdc, 0, 0, ddsd.dwWidth, ddsd.dwHeight, hdcImage, 0, 0, bm.bmWidth, bm.bmHeight, SRCCOPY
' Release the surface's DC
dds.ReleaseDC lhdc
' Release the memory device and the bitmap
DeleteDC hdcImage
DeleteObject hbm
' Returns the new surface
Set GraphicSurfaces(Index) = dds
End Sub
Private Function CreateDDSFromBitmapDirectly(dd As DirectDraw2, ByVal strFile As String) As DirectDrawSurface2
Dim hbm As Long                 ' Handle on bitmap
Dim bm As BITMAP                ' Bitmap header
Dim ddsd As DDSURFACEDESC       ' Surface description
Dim dds As DirectDrawSurface2   ' Created surface
Dim hdcImage As Long            ' Handle on image
Dim lhdc As Long                ' Handle on surface context
' Load bitmap
hbm = LoadImage(ByVal 0&, strFile, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)
' Get bitmap info
GetObject hbm, Len(bm), bm
' Fill surface description
With ddsd
    .dwSize = Len(ddsd)
    .dwFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
    .DDSCAPS.dwCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
    .dwWidth = bm.bmWidth
    .dwHeight = bm.bmHeight
End With
' Create surface
dd.CreateSurface ddsd, dds, Nothing
' Create memory device
hdcImage = CreateCompatibleDC(ByVal 0&)
' Select the bitmap in this memory device
SelectObject hdcImage, hbm
' Restore the surface
dds.Restore
' Get the surface's DC
dds.GetDC lhdc
' Copy from the memory device to the DirectDrawSurface
StretchBlt lhdc, 0, 0, ddsd.dwWidth, ddsd.dwHeight, hdcImage, 0, 0, bm.bmWidth, bm.bmHeight, SRCCOPY
' Release the surface's DC
dds.ReleaseDC lhdc
' Release the memory device and the bitmap
DeleteDC hdcImage
DeleteObject hbm
' Returns the new surface
Set CreateDDSFromBitmapDirectly = dds
End Function
Sub LoadGraphic(Index, Filename)
SpriteStuff.GraphicsLibs(Index).Active = True
Call GraphicsEngine.LoadGraphicOntoGraphicLib(Index, dd, Filename)
Call prepSrcColorKey(GraphicSurfaces(Index))
End Sub
Sub DisplayTextCenter(Text, Y, Pallete)
textlength = Len(Text)
X = ResolutionMidX - ((textlength * FONT_SPACINGX) / 2)
Call DisplayText(Text, X, Y, Pallete)
End Sub
Sub DisplayTextCenterRelative(Text, X, Y, Pallete)
textlength = Len(Text)
XDisp = X - ((textlength * FONT_SPACINGX) / 2)
YDisp = Y - ((FONT_SPACINGY) / 2)
Call DisplayText(Text, XDisp, YDisp, Pallete)
End Sub
Sub DisplayText(Text, X, Y, Pallete)
Dim DestBox As RECT, SrcBox As RECT
On Error Resume Next
TextString$ = UCase$(Text)
textlength = Len(TextString$)
For I = 1 To textlength
  CurrentCharacter$ = Mid$(TextString$, I, 1)
  If CurrentCharacter$ <> " " Then
      Select Case CurrentCharacter$
      Case "A"
        TextX = 0
        texty = 0
      Case "B"
        TextX = 1
        texty = 0

      Case "C"
        TextX = 2
        texty = 0
      Case "D"
        TextX = 3
        texty = 0
      Case "E"
        TextX = 4
        texty = 0
      Case "F"
        TextX = 5
        texty = 0

      Case "G"
        TextX = 6
        texty = 0
      Case "H"
        TextX = 7
        texty = 0
      Case "I"
        TextX = 8
        texty = 0
      Case "J"
        TextX = 9
        texty = 0
      Case "K"
        TextX = 10
        texty = 0
      Case "L"
        TextX = 11
        texty = 0
      Case "M"
        TextX = 12
        texty = 0
      Case "N"
        TextX = 13
        texty = 0
      Case "O"
        TextX = 14
        texty = 0
      Case "P"
        TextX = 15
        texty = 0
      Case "Q"
        TextX = 16
        texty = 0
      Case "R"
        TextX = 17
        texty = 0
      Case "S"
        TextX = 18
        texty = 0
      Case "T"
        TextX = 19
        texty = 0
      Case "U"
        TextX = 20
        texty = 0
      Case "V"
        TextX = 21
        texty = 0
      Case "W"
        TextX = 22
        texty = 0
      Case "X"
        TextX = 23
        texty = 0
      Case "Y"
        TextX = 24
        texty = 0
      Case "Z"
        TextX = 25
        texty = 0
      Case "1"
        TextX = 26
        texty = 0
      Case "2"
        TextX = 27
        texty = 0
      Case "3"
        TextX = 28
        texty = 0
      Case "4"
        TextX = 0
        texty = 1
      Case "5"
        TextX = 1
        texty = 1
      Case "6"
        TextX = 2
        texty = 1
      Case "7"
        TextX = 3
        texty = 1

      Case "8"
        TextX = 4
        texty = 1
      Case "9"
        TextX = 5
        texty = 1
      Case "0"
        TextX = 6
        texty = 1
      Case "."
        TextX = 7
        texty = 1
      Case ","
        TextX = 8
        texty = 1
      Case "?"
        TextX = 9
        texty = 1
      Case "!"
        TextX = 10
        texty = 1
      Case "*"
        TextX = 11
        texty = 1
      Case "/"
        TextX = 12
        texty = 1
      Case "\"
        TextX = 13
        texty = 1
      Case "["
        TextX = 14
        texty = 1
      Case "]"
        TextX = 15
        texty = 1
      Case "("
        TextX = 16
        texty = 1
      Case ")"
        TextX = 17
        texty = 1
      Case "$"
        TextX = 18
        texty = 1
      Case "#"
        TextX = 19
        texty = 1
      Case "<"
        TextX = 20
        texty = 1
      Case ">"
        TextX = 21
        texty = 1
      Case "&"
        TextX = 22
        texty = 1
      Case "@"
        TextX = 22
        texty = 1

      Case "-"
        TextX = 23
        texty = 1
      Case "+"
        TextX = 24
        texty = 1
      Case "="
        TextX = 25
        texty = 1
      Case "'"
        TextX = 26
        texty = 1
      Case CHARACTER_QOUTE
        TextX = 27
        texty = 1
      Case ":"
        TextX = 28
        texty = 1
      End Select
      If X < 0 Then
        DestBox.Left = ((FONT_LastCharacter - (-(I - 1) + textlength)) * FONT_SPACINGX) - FONT_SPACINGX
        DestBox.Right = DestBox.Left + FONT_SIZE
      Else
        DestBox.Left = ((I - 1) * FONT_SPACINGX) + X
        DestBox.Right = DestBox.Left + FONT_SIZE
      End If
      DestBox.Top = Y
      DestBox.bottom = DestBox.Top + FONT_SIZE
      SrcBox.Top = texty * FONT_SIZE
      SrcBox.bottom = (texty + 1) * FONT_SIZE
      SrcBox.Left = TextX * FONT_SIZE
      SrcBox.Right = (TextX + 1) * FONT_SIZE

      If Pallete = PALLETE_WHITE Then
        SrcBox.Top = SrcBox.Top + GraphicsLibs(InGameConstants(InGameConstant_PICINDEX_FontLib)).HalfHeight
        SrcBox.bottom = SrcBox.bottom + GraphicsLibs(InGameConstants(InGameConstant_PICINDEX_FontLib)).HalfHeight
      End If

      ' Set the transparent color
      GraphicSurfaces(InGameConstants(InGameConstant_PICINDEX_FontLib)).Restore
      ' Blit the image to the back buffer



      ddsBack.BltFast DestBox.Left, DestBox.Top, GraphicSurfaces(InGameConstants(InGameConstant_PICINDEX_FontLib)), SrcBox, DDBLTFAST_WAIT Or DDBLTFAST_SRCCOLORKEY



  End If
Next I
End Sub